home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / File / Compare.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  3.0 KB  |  141 lines
  1. package File::Compare;
  2.  
  3. use strict;
  4. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $Too_Big *FROM *TO);
  5.  
  6. require Exporter;
  7. use Carp;
  8.  
  9. $VERSION = '1.1001';
  10. @ISA = qw(Exporter);
  11. @EXPORT = qw(compare);
  12. @EXPORT_OK = qw(cmp);
  13.  
  14. $Too_Big = 1024 * 1024 * 2;
  15.  
  16. sub VERSION {
  17.     return $File::Compare::VERSION;
  18. }
  19.  
  20. sub compare {
  21.     croak("Usage: compare( file1, file2 [, buffersize]) ")
  22.       unless(@_ == 2 || @_ == 3);
  23.  
  24.     my $from = shift;
  25.     my $to = shift;
  26.     my $closefrom=0;
  27.     my $closeto=0;
  28.     my ($size, $fromsize, $status, $fr, $tr, $fbuf, $tbuf);
  29.     local(*FROM, *TO);
  30.     local($\) = '';
  31.  
  32.     croak("from undefined") unless (defined $from);
  33.     croak("to undefined") unless (defined $to);
  34.  
  35.     if (ref($from) && 
  36.         (UNIVERSAL::isa($from,'GLOB') || UNIVERSAL::isa($from,'IO::Handle'))) {
  37.     *FROM = *$from;
  38.     } elsif (ref(\$from) eq 'GLOB') {
  39.     *FROM = $from;
  40.     } else {
  41.     open(FROM,"<$from") or goto fail_open1;
  42.     binmode FROM;
  43.     $closefrom = 1;
  44.     $fromsize = -s FROM;
  45.     }
  46.  
  47.     if (ref($to) &&
  48.         (UNIVERSAL::isa($to,'GLOB') || UNIVERSAL::isa($to,'IO::Handle'))) {
  49.     *TO = *$to;
  50.     } elsif (ref(\$to) eq 'GLOB') {
  51.     *TO = $to;
  52.     } else {
  53.     open(TO,"<$to") or goto fail_open2;
  54.     binmode TO;
  55.     $closeto = 1;
  56.     }
  57.  
  58.     if ($closefrom && $closeto) {
  59.     goto fail_inner if $fromsize != -s TO;
  60.     }
  61.  
  62.     if (@_) {
  63.     $size = shift(@_) + 0;
  64.     croak("Bad buffer size for compare: $size\n") unless ($size > 0);
  65.     } else {
  66.     $size = $fromsize;
  67.     $size = 1024 if ($size < 512);
  68.     $size = $Too_Big if ($size > $Too_Big);
  69.     }
  70.  
  71.     $fbuf = '';
  72.     $tbuf = '';
  73.     while(defined($fr = read(FROM,$fbuf,$size)) && $fr > 0) {
  74.     unless (defined($tr = read(TO,$tbuf,$fr)) and $tbuf eq $fbuf) {
  75.             goto fail_inner;
  76.     }
  77.     }
  78.     goto fail_inner if (defined($tr = read(TO,$tbuf,$size)) && $tr > 0);
  79.  
  80.     close(TO) || goto fail_open2 if $closeto;
  81.     close(FROM) || goto fail_open1 if $closefrom;
  82.  
  83.     return 0;
  84.     
  85.   fail_inner:
  86.     close(TO) || goto fail_open2 if $closeto;
  87.     close(FROM) || goto fail_open1 if $closefrom;
  88.  
  89.     return 1;
  90.  
  91.   fail_open2:
  92.     if ($closefrom) {
  93.     $status = $!;
  94.     $! = 0;
  95.     close FROM;
  96.     $! = $status unless $!;
  97.     }
  98.   fail_open1:
  99.     return -1;
  100. }
  101.  
  102. *cmp = \&compare;
  103.  
  104. 1;
  105.  
  106. __END__
  107.  
  108. =head1 NAME
  109.  
  110. File::Compare - Compare files or filehandles
  111.  
  112. =head1 SYNOPSIS
  113.  
  114.       use File::Compare;
  115.  
  116.     if (compare("file1","file2") == 0) {
  117.         print "They're equal\n";
  118.     }
  119.  
  120. =head1 DESCRIPTION
  121.  
  122. The File::Compare::compare function compares the contents of two
  123. sources, each of which can be a file or a file handle.  It is exported
  124. from File::Compare by default.
  125.  
  126. File::Compare::cmp is a synonym for File::Compare::compare.  It is
  127. exported from File::Compare only by request.
  128.  
  129. =head1 RETURN
  130.  
  131. File::Compare::compare return 0 if the files are equal, 1 if the
  132. files are unequal, or -1 if an error was encountered.
  133.  
  134. =head1 AUTHOR
  135.  
  136. File::Compare was written by Nick Ing-Simmons.
  137. Its original documentation was written by Chip Salzenberg.
  138.  
  139. =cut
  140.  
  141.